home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / w / wissensc / funktion / quelle / funktion.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-18  |  24.3 KB  |  784 lines
  1. {$S130}
  2. PROGRAM funktion ;
  3.  
  4. {-----------------------------------------------------------------------------}
  5. { (c) Thomas Proffen                                                 Mai 1987 }
  6. {-----------------------------------------------------------------------------}
  7.  
  8.  
  9.       {$I A:\FUNKTION\FUNKTION.I }
  10.       {$I C:\GEM\GEMCONST.PAS    }
  11.  
  12. TYPE  {$I C:\GEM\GEMTYPE.PAS     }
  13.  
  14.       bild_type                  = ARRAY [0..16000] OF integer ;
  15.       bild_zeiger                = ^bild_type ;
  16.       k_sin_type                 = RECORD
  17.                                     name      : str255 ;
  18.                                     wert      : real ;
  19.                                    END ;
  20.       achsen_art_type            = (ohne, skala, netz) ;
  21.       draw_type                  = RECORD
  22.                                     achsen_art           : achsen_art_type ;
  23.                                     verb, auto, x_log,
  24.                                     y_log                : boolean ;
  25.                                     x_min, x_max, y_min,
  26.                                     y_max,
  27.                                     dx, dy,
  28.                                     x_skala, y_skala     : real ;
  29.                                     min_pot_x, max_pot_x,
  30.                                     min_pot_y, max_pot_y,
  31.                                     null_x, null_y       : integer ;
  32.                                    END ;
  33.       konst_type                 = ARRAY[1..20]  OF k_sin_type ;
  34.       zahl_str_type              = ARRAY[1..20]  OF str255 ;
  35.       fkt_wert_type              = ARRAY[1..600] OF real ;
  36.       error_feld_type            = ARRAY[1..600] OF integer ;
  37.       error_str_type             = ARRAY[1..30]  OF string ;
  38.  
  39.       {-- f. AES - Calls  --}
  40.  
  41.       Pointer                    = ^char ;
  42.       Int_In_Parms               = ARRAY[0..15] OF integer ;
  43.       Int_Out_Parms              = ARRAY[0..45] OF integer ;
  44.       Addr_In_Parms              = ARRAY[0..1]  OF Pointer ;
  45.       Addr_Out_Parms             = ARRAY[0..0]  OF Pointer ;
  46.  
  47. VAR   {-- GEM - Variablen --}
  48.  
  49.       menu_zei                                   : Menu_Ptr ;
  50.       info_zei, lauf_zei, fktein_zei, werte_zei,
  51.       koein_zei, darst_zei, drucker_zei, w1_zei,
  52.       help_zei, warten_zei, ausgabe_zei, w2_zei  : Dialog_Ptr ;
  53.       msg                                        : Message_Buffer ;
  54.       titel                                      : Window_Title ;
  55.       window, pushed, event, dummy, button       : integer ;
  56.  
  57.       {-- f. AES - Calls       --}
  58.  
  59.       int_in                                     : Int_In_Parms ;
  60.       int_out                                    : Int_Out_Parms ;
  61.       addr_out                                   : Addr_Out_Parms ;
  62.       addr_in                                    : Addr_In_Parms ;
  63.  
  64.       {-- Programm - Variablen --}
  65.  
  66.       bild                                       : bild_type ;
  67.       bild_ptr                                   : bild_zeiger ;
  68.       draw                                       : draw_type ;
  69.       zahl_str                                   : zahl_str_type ;
  70.       fkt, var_x, var_y, pfad_akt                : str255 ;
  71.       konst                                      : konst_type ;
  72.       fkt_wert                                   : fkt_wert_type ;
  73.       error_feld                                 : error_feld_type ;
  74.       error_str, warn                            : error_str_type ;
  75.       ergebnis                                   : real ;
  76.       bild_art                                   : (mono, degas) ;
  77.       neu_fkt, low_flag, test_flag, neu_rechnen  : boolean ;
  78.       fehler, step, mx, my                       : integer ;
  79.  
  80.       {$I C:\GEM\GEMSUBS.PAS    }
  81.  
  82.  
  83. {---------------------  Bertiebssystem - Aufrufe  ----------------------------}
  84.  
  85. FUNCTION  Bild_ram : Bild_zeiger ; XBIOS (2) ;
  86.  
  87. FUNCTION  IO_Result : integer ; EXTERNAL ;
  88.  
  89. FUNCTION  Set_Printer (config : integer) : integer ; XBIOS (33) ;
  90.  
  91. FUNCTION  Taste_Lesen : integer ; GEMDOS ($07) ;
  92.  
  93. FUNCTION  Taste_Druck : integer ; GEMDOS ($0B) ;
  94.  
  95. PROCEDURE IO_Check (was : boolean) ; EXTERNAL ;
  96.  
  97.  
  98. {--------------------- Forward - Deklarationen -------------------------------}
  99.  
  100. PROCEDURE Do_Funktion_Zeichnen (redraw : boolean) ; FORWARD ;
  101.  
  102.  
  103. {------------------------ Includen der Module --------------------------------}
  104.  
  105. {$I A:\FUNKTION\PARSER.PAS    }
  106. {$I A:\FUNKTION\GEMHELP.PAS   }
  107. {$I C:\DRAW.PAS               }
  108.  
  109.  
  110. {---- Do_Init ----------------------------------------------------------------}
  111.  
  112. PROCEDURE Do_Init ;
  113.  
  114.  VAR  config      : integer ;
  115.       par_datei   : text ;
  116.  
  117.  BEGIN
  118.   {-- Buttons und Flags setzen --}
  119.  
  120.   draw.verb        := true ;
  121.   draw.x_log       := false ;
  122.   draw.y_log       := false ;
  123.   draw.auto        := false ;
  124.   draw.achsen_art  := netz ;
  125.  
  126.   {-- Häkchen im Menü --}
  127.  
  128.   Menu_Check (menu_zei, mfdegas, true) ;
  129.   bild_art   := degas ;
  130.   Menu_Check (menu_zei, mfktneu, true) ;
  131.   neu_fkt    := true ;
  132.  
  133.   {-- Zeichengrenzen defaulten --}
  134.  
  135.   Set_DText (werte_zei, zxmin, '-10', System_Font, TE_Left) ;
  136.   Set_DText (werte_zei, zxmax, '10', System_Font, TE_Left) ;
  137.   Set_DText (werte_zei, zymin, '-10', System_Font, TE_Left) ;
  138.   Set_DText (werte_zei, zymax, '10', System_Font, TE_Left) ;
  139.  
  140.   Set_DText (werte_zei, wskalax, '1', System_Font, TE_Left) ;
  141.   Set_DText (werte_zei, wskalay, '1', System_Font, TE_Left) ;
  142.  
  143.   draw.x_min := -10 ;
  144.   draw.x_max := 10  ;
  145.   draw.y_min := -10 ;
  146.   draw.y_max := 10  ;
  147.  
  148.   draw.x_skala := 1 ;
  149.   draw.y_skala := 1 ;
  150.  
  151.   {-- Pfadname --}
  152.  
  153.   IO_Check (false) ;
  154.   RESET (par_datei, 'FUNKTION.INF') ;
  155.   IO_Check (true) ;
  156.   IF IO_Result = 0 THEN
  157.    readln (par_datei, pfad_akt)
  158.   ELSE
  159.    pfad_akt := 'A:\BILDER\' ;
  160.   Set_DText (lauf_zei, lpfad, pfad_akt, System_Font, TE_Left) ;
  161.  
  162.   {-- Druckeranpassung --}
  163.  
  164.   low_flag := true ;
  165.   Obj_SetState (drucker_zei, bp980, selected, false) ;
  166.   test_flag := true ;
  167.   Obj_SetState (drucker_zei, dqtest, selected, false) ;
  168.  
  169.   config := Set_Printer (-1) ;
  170.   IF (config & $0004) <> 0 THEN config := config - 4 ;
  171.   IF (config & $0008) <> 0 THEN config := config - 8 ;
  172.   config := config | $0004 ;
  173.   config := Set_Printer (config) ;
  174.  
  175.   {-- Sonstiges --}
  176.  
  177.   konst[1].name := 'ende' ;
  178.   fkt := 'sin(x)' ;
  179.   Set_DText (fktein_zei, funkt, 'sin(x)', System_Font, TE_Left) ;
  180.  
  181.   var_x := 'x' ;
  182.   Set_DText (fktein_zei, fvarx, 'x', System_Font, TE_Left) ;
  183.   Obj_SetState (fktein_zei, fvary, disabled, false) ; { 2.Variable disabled }
  184.  
  185.   step := 5 ;
  186.   Set_DText (warten_zei, wstepfel, '5', System_Font, TE_Center) ;
  187.   neu_rechnen := true ;
  188.  END ;
  189.  
  190.  
  191. {---- Do_Init_Warnungen : Setzt Warnungstexte zu Beginn d. Programms ---------}
  192.  
  193. PROCEDURE Do_Init_Warnungen ;
  194.  
  195.  BEGIN
  196.   warn[ 1] := '[3][ Ungültige x-Grenzen !! ][ verstanden ]' ;
  197.   warn[ 2] := '[3][ Log. Einteilung x muß > 0 sein ! ][ ok ]' ;
  198.   warn[ 3] := '[3][ Ungültige y-Grenzen !! ][ verstanden ]' ;
  199.   warn[ 4] := '[3][ Log. Einteilung y muß > 0 sein ! ][ ok ]' ;
  200.   warn[11] := '[3][ Sinnvolle x-Skalierung, was !! ][ ahh ]' ;
  201.   warn[12] := '[3][ Sinnvolle y-Skalierung, was !! ][ ahh ]' ;
  202.   warn[13] := '[3][ Skalierung 0 ist auch schön ... ][ na gut ]' ;
  203.   warn[21] := '[3][ Berechnung wurde abgebrochen .. ][ ach so ] ' ;
  204.   warn[22] := '[3][ Ich sehe kein altes Koordinatenkreuz, DU ? ][ hmm ] ' ;
  205.  END ;
  206.  
  207.  
  208. {---- Do_Eingabe_Konstanten : Eingabe der erkannten Konstanten ---------------}
  209.  
  210. PROCEDURE Do_Eingabe_Konstanten ;
  211.  
  212.  VAR   index                    : integer ;
  213.        erfolg                   : boolean ;
  214.  
  215.  BEGIN
  216.   index := 1 ;
  217.   WHILE konst[index].name <> 'ende' DO
  218.    BEGIN
  219.     Set_DText (koein_zei, kname, konst[index].name, System_Font, TE_Center) ;
  220.     Set_DText (koein_zei, kwert, zahl_str[index], System_Font, TE_Center) ;
  221.     IF index = 1 THEN pushed := Do_Dialog (koein_zei, kwert)
  222.     ELSE
  223.      BEGIN
  224.       Obj_SetState (koein_zei, kname, disabled, false) ;
  225.       Obj_SetState (koein_zei, kname, normal, true) ;
  226.       Obj_SetState (koein_zei, kwert, disabled, false) ;
  227.       Obj_SetState (koein_zei, kwert, normal, true) ;
  228.       pushed := Redo_Dialog (koein_zei, kwert) ;
  229.      END ;
  230.     Obj_SetState (koein_zei, pushed, normal, true) ;
  231.     erfolg := Zahl_Einlesen (koein_zei, kwert, konst[index].wert) ;
  232.     Get_DEdit (koein_zei, kwert, zahl_str[index]) ;
  233.     IF erfolg THEN index := index + 1 ;
  234.    END ;
  235.   End_Dialog (koein_zei) ;
  236.  END ;
  237.  
  238.  
  239. {---- Do_Eingabe_Grenzen : Regelt die Eingabe der Zeichenparameter -----------}
  240.  
  241. PROCEDURE Do_Eingabe_Grenzen (user : boolean) ;
  242.  
  243.  VAR  err_pos                : integer ;
  244.       erfolg                 : boolean ;
  245.       help, help_1, help_2   : real ;
  246.  
  247.  BEGIN
  248.   pushed := Do_Dialog (werte_zei, zxmin) ;
  249.   LOOP
  250.    Obj_SetState (werte_zei, pushed, normal, true) ;
  251.    erfolg := true ;
  252.    err_pos := -1 ;
  253.  
  254.    erfolg := Zahl_Einlesen (werte_zei, zxmin, help_1) ;
  255.    IF NOT erfolg THEN err_pos := zxmin ;
  256.    erfolg := Zahl_Einlesen (werte_zei, zxmax, help_2) ;
  257.    IF NOT erfolg THEN err_pos := zxmax ;
  258.    erfolg := Zahl_Einlesen (werte_zei, zymin, help) ;
  259.    IF NOT erfolg THEN err_pos := zymin ;
  260.    erfolg := Zahl_Einlesen (werte_zei, zymax, help) ;
  261.    IF NOT erfolg THEN err_pos := zymax ;
  262.  
  263.    erfolg := Zahl_Einlesen (werte_zei, wskalax, help) ;
  264.    IF NOT erfolg THEN err_pos := wskalax ;
  265.    erfolg := Zahl_Einlesen (werte_zei, wskalay, help) ;
  266.    IF NOT erfolg THEN err_pos := wskalay ;
  267.  
  268.   EXIT IF err_pos = -1 ;
  269.    pushed := Redo_Dialog (werte_zei, err_pos) ;
  270.   END ;
  271.   End_Dialog (werte_zei) ;
  272.  
  273.   IF neu_fkt AND user THEN
  274.    BEGIN
  275.     IF (help_1 <> draw.x_min) OR (help_2 <> draw.x_max) OR neu_rechnen THEN
  276.      BEGIN
  277.       button := Do_Alert
  278.                 ('[3][ Funktion muß neu | berechnet werden ][ OK ]', 1) ;
  279.       neu_rechnen := true ;
  280.      END
  281.     ELSE
  282.      Do_Funktion_Zeichnen (true) ;
  283.    END ;
  284.  END ;
  285.  
  286.  
  287. {---- Do_Eingabe_Funktion : Eingabe der zu zeichnenden Funktion --------------}
  288.  
  289. PROCEDURE Do_Eingabe_Funktion ;
  290.  
  291.  VAR  fehler_str              : str255 ;
  292.       error                   : integer ;
  293.       fehler                  : boolean ;
  294.  
  295.  BEGIN
  296.   neu_rechnen := true ;
  297.   fehler_str :=
  298.   '                                                                 ' ;
  299.   Set_DText (fktein_zei, fehlpos, fehler_str, System_Font, TE_Center) ;
  300.   pushed := Do_Dialog (fktein_zei, funkt) ;
  301.   Obj_SetState (fktein_zei, pushed, normal, true) ;
  302.   Get_DEdit (fktein_zei, funkt, fkt) ;
  303.   Get_DEdit (fktein_zei, fvarx, var_x) ;
  304.   Get_DEdit (fktein_zei, fvary, var_y) ;
  305.  
  306.   fehler := Fkt_Analyse (fkt, konst, var_x, var_y) ;
  307.   error := Do_Berechnen (fkt, konst, 0.5, 0.5, var_x, var_y, ergebnis) ;
  308.  
  309.   WHILE error > 0 DO
  310.    BEGIN
  311.     fehler_str[error] := '^' ;
  312.     Set_DText (fktein_zei, fehlpos, fehler_str, System_Font, TE_Center) ;
  313.     Obj_SetState (fktein_zei, fehlpos, disabled, true) ;
  314.     Obj_SetState (fktein_zei, fehlpos, normal, true) ;
  315.     fehler_str[error] := ' ' ;
  316.  
  317.     pushed := Redo_Dialog (fktein_zei, funkt) ;
  318.     Obj_SetState (fktein_zei, pushed, normal, true) ;
  319.     Get_DEdit (fktein_zei, funkt, fkt) ;
  320.  
  321.     fehler := Fkt_Analyse (fkt, konst, var_x, var_y) ;
  322.     error  := Do_Berechnen (fkt, konst, 0.5, 0.5, var_x, var_y, ergebnis) ;
  323.    END ;
  324.   Get_DEdit (fktein_zei, fvarx, var_x) ;
  325.   Get_DEdit (fktein_zei, fvary, var_y) ;
  326.   End_Dialog (fktein_zei) ;
  327.  
  328.   IF konst[1].name <> 'ende' THEN Do_Eingabe_Konstanten ;
  329.   Do_Screen_Aktualisieren ;
  330.   Draw_Menu (menu_zei) ;
  331.   Do_Eingabe_Grenzen (false) ;
  332.  END ;
  333.  
  334.  
  335. {---- Do_Set_Pfad : Eingabe des gewünschten Pfades ---------------------------}
  336.  
  337. PROCEDURE Do_Set_Pfad ;
  338.  
  339.  VAR  par_datei       : text ;
  340.  
  341.  BEGIN
  342.   pushed := Do_Dialog (lauf_zei, lpfad) ;
  343.   Obj_SetState (lauf_zei, pushed, normal, true) ;
  344.   Get_DEdit  (lauf_zei, lpfad, pfad_akt) ;
  345.   IF pushed = lsave THEN
  346.    BEGIN
  347.     Set_Mouse (M_Bee) ;
  348.     REWRITE (par_datei, 'FUNKTION.INF') ;
  349.     writeln (par_datei, pfad_akt) ;
  350.     Set_Mouse (M_Arrow) ;
  351.    END ;
  352.   End_Dialog (lauf_zei) ;
  353.  END ;
  354.  
  355.  
  356. {---- Do_Parameter : Übernimmt Parameter vom Dialog --------------------------}
  357.  
  358. PROCEDURE Do_Parameter ;
  359.  
  360.  VAR  help_flag, dummy_flag        : boolean ;
  361.  
  362.  BEGIN
  363.   help_flag := draw.x_log ;
  364.   pushed := Do_Dialog (darst_zei, 0) ;
  365.   Obj_SetState (darst_zei, pushed, normal, true) ;
  366.   End_Dialog  (darst_zei) ;
  367.   Test_Button (darst_zei, dalogx, draw.x_log) ;
  368.   Test_Button (darst_zei, dalogy, draw.y_log) ;
  369.   Test_Button (darst_zei, papuver, draw.verb) ;
  370.   Test_Button (darst_zei, danetz, dummy_flag) ;
  371.   IF dummy_flag THEN draw.achsen_art := netz ;
  372.   Test_Button (darst_zei, daohne, dummy_flag) ;
  373.   IF dummy_flag THEN draw.achsen_art := ohne ;
  374.   Test_Button (darst_zei, daskal, dummy_flag) ;
  375.   IF dummy_flag THEN draw.achsen_art := skala ;
  376.   Test_Button (darst_zei, daautoy, draw.auto) ;
  377.  
  378.   {-- Verändern, je nach Flags --}
  379.  
  380.   IF draw.x_log THEN
  381.    Obj_SetState (werte_zei, wskalax, disabled, false)
  382.   ELSE
  383.    Obj_SetState (werte_zei, wskalax, normal, false) ;
  384.   IF draw.y_log THEN
  385.    Obj_SetState (werte_zei, wskalay, disabled, false)
  386.   ELSE
  387.    Obj_SetState (werte_zei, wskalay, normal, false) ;
  388.  
  389.   IF draw.auto THEN
  390.    BEGIN
  391.     Obj_SetState (werte_zei, zymin, disabled, false) ;
  392.     Obj_SetState (werte_zei, zymax, disabled, false) ;
  393.    END
  394.   ELSE
  395.    BEGIN
  396.     Obj_SetState (werte_zei, zymin, normal, false) ;
  397.     Obj_SetState (werte_zei, zymax, normal, false) ;
  398.    END ;
  399.  
  400.   IF neu_fkt THEN
  401.    BEGIN
  402.     IF (help_flag <> draw.x_log) OR neu_rechnen THEN
  403.      BEGIN
  404.       button := Do_Alert
  405.                 ('[3][ Funktion muß neu | berechnet werden ][ OK ]', 1) ;
  406.       neu_rechnen := true ;
  407.      END
  408.     ELSE
  409.      Do_Funktion_Zeichnen (true) ;
  410.    END ;
  411.  END ;
  412.  
  413.  
  414. {---- Do_Berechnen_Funktion --------------------------------------------------}
  415.  
  416. FUNCTION  Do_Berechnen_Funktion : integer ;
  417.  
  418.  VAR  i, falsch                 : integer ;
  419.       wert_x                    : real ;
  420.  
  421.  BEGIN
  422.   Show_Mouse ;
  423.   Set_DText (warten_zei, werror, ' ', System_Font, TE_Center) ;
  424.   pushed := Do_Dialog (warten_zei, 0) ;
  425.  
  426.   WHILE (pushed = wstepplu) OR (pushed = wstepmin) DO
  427.    BEGIN
  428.     CASE pushed OF
  429.      wstepmin    : IF step > 1   THEN step := step - 1 ;
  430.      wstepplu    : IF step < 300 THEN step := step + 1 ;
  431.     END ;
  432.     Do_Aktualisieren (warten_zei, wstepfel, step) ;
  433.     pushed := Redo_Dialog (warten_zei, 0) ;
  434.    END ;
  435.   Hide_Mouse ;
  436.  
  437.   IF pushed = wsinja THEN
  438.    write (CHR(27),'Y',CHR(41),CHR(53),' Noch kein nicht definierter Wert ! ') ;
  439.  
  440.   IF pushed = wsindru THEN
  441.    BEGIN
  442.     REWRITE (output, 'PRN:') ;
  443.     writeln ('   Singularitaeten von : y(', var_x,') = ', fkt) ;
  444.     writeln ; writeln ;
  445.     REWRITE (output, 'CON:') ;
  446.    END ;
  447.  
  448.   i := 1 ;
  449.   WHILE i <= 600 DO
  450.    BEGIN
  451.     IF draw.x_log THEN wert_x := EXP (((i-draw.null_x) / draw.dx) * LN (10))
  452.     ELSE               wert_x := (i - draw.null_x) / draw.dx ;
  453.     falsch := Do_Berechnen (fkt, konst, wert_x, 0, var_x, var_y, fkt_wert[i]) ;
  454.     error_feld[i] := falsch ;
  455.  
  456.     IF (falsch < 0) THEN
  457.      BEGIN
  458.       IF pushed = wsinja THEN
  459.        BEGIN
  460.         write (CHR(27),'Y',CHR(41),CHR(52),'Nicht defininierter Wert bei : ',
  461.         wert_x :10:6) ;
  462.         Set_DText (warten_zei, werror, error_str[ABS(falsch)], System_Font,
  463.                    TE_Center) ;
  464.         Obj_SetState (warten_zei, werror, disabled, false) ;
  465.         Obj_SetState (warten_zei, werror, normal, true) ;
  466.        END ;
  467.  
  468.       IF pushed = wsindru THEN
  469.        BEGIN
  470.         REWRITE (output, 'PRN:') ;
  471.         writeln ('   Bei x = ', wert_x:10:6, '      Grund : ',
  472.                  error_str[ABS(falsch)]) ;
  473.         REWRITE (output, 'CON:') ;
  474.        END ;
  475.      END ;
  476.     i := i + step ;
  477.     IF Taste_Druck = -1 THEN
  478.      BEGIN
  479.       IF Taste_Lesen = ORD(' ') THEN
  480.        BEGIN
  481.         button := Do_Alert ('[2][ Wirklich abbrechen ? ][ Ja | Nein ]', 2) ;
  482.         IF button = 1 THEN i := 999 ;
  483.        END ;
  484.      END ;
  485.    END ;
  486.   Obj_SetState (warten_zei, pushed, normal, true) ;
  487.   End_Dialog (warten_zei) ;
  488.  
  489.   IF i = 999 THEN Do_Berechnen_Funktion := 21
  490.   ELSE
  491.    BEGIN
  492.     Do_Berechnen_Funktion := 0 ;
  493.     neu_rechnen := false ;
  494.    END ;
  495.  END ;
  496.  
  497.  
  498. {---- Do_Funktion_Zeichnen ---------------------------------------------------}
  499.  
  500. PROCEDURE Do_Funktion_Zeichnen ;  { -- wurde FORWARD deklariert !! -- }
  501.  
  502.  VAR  old_kreuz                : boolean ;
  503.       fehler                   : integer ;
  504.  
  505.  BEGIN
  506.   old_kreuz := false ; fehler := 0 ;
  507.  
  508.   IF NOT redraw THEN
  509.    BEGIN
  510.     button := Do_Alert
  511.     ('[3][Altes Koordinatenkreuz |   verwenden ?][ Ja | Nein ]', 2) ;
  512.     IF   button = 1 THEN old_kreuz := true ;
  513.     IF (draw.dx = draw.dy) AND Old_Kreuz THEN fehler := 22 ;
  514.    END ;
  515.  
  516.   Hide_Mouse ;
  517.  
  518.   IF Old_Kreuz THEN
  519.    BEGIN
  520.     IF fehler = 0 THEN fehler := Do_Berechnen_Funktion ;
  521.     Do_Screen_Aktualisieren ;
  522.     IF fehler = 0 THEN Do_Draw_Funktion (draw, fkt_wert, error_feld, step)
  523.     ELSE               button := Do_Alert (warn[fehler], 1) ;
  524.    END
  525.   ELSE
  526.    BEGIN
  527.     IF NOT redraw THEN
  528.      BEGIN
  529.       fehler := Do_x_Koordinaten (draw, fkt_wert);
  530.       IF fehler = 0 THEN fehler := Do_Berechnen_Funktion ;
  531.      END ;
  532.     IF fehler = 0 THEN fehler   := Do_y_Koordinaten (draw, fkt_wert) ;
  533.     IF fehler = 0 THEN
  534.      BEGIN
  535.       write (CHR(27), 'E') ;
  536.       Do_Draw_Funktion (draw, fkt_wert, error_feld, step) ;
  537.      END
  538.     ELSE               button := Do_Alert (warn[fehler], 1) ;
  539.    END ;
  540.  
  541.   Draw_Menu (menu_zei) ;
  542.   Show_Mouse ;
  543.  END ;
  544.  
  545.  
  546. {---- Do_Set_Drucker : Setzt die Druckerparameter ----------------------------}
  547.  
  548. PROCEDURE Do_Set_Drucker ;
  549.  
  550.  VAR  config                 : integer ;
  551.  
  552.  BEGIN
  553.   pushed := Do_Dialog (drucker_zei, 0) ;
  554.   Obj_SetState (drucker_zei, pushed, normal, true) ;
  555.   End_Dialog (drucker_zei) ;
  556.  
  557.   Test_Button (drucker_zei, bp980,  low_flag) ;
  558.   Test_Button (drucker_zei, dqtest, test_flag) ;
  559.  
  560.   config := Set_Printer (-1) ;
  561.   IF (config & $0004) <> 0 THEN config := config - 4 ;
  562.   IF (config & $0008) <> 0 THEN config := config - 8 ;
  563.   IF low_flag       THEN config := config | $0004 ;
  564.   IF NOT test_flag  THEN config := config | $0008 ;
  565.   config := Set_Printer (config) ;
  566.  
  567.  END ;
  568.  
  569.  
  570. {---- Do_Drucken : Druckt das Bild aus ---------------------------------------}
  571.  
  572. PROCEDURE Do_Drucken ;
  573.  
  574.  PROCEDURE Hard_Copy ; XBIOS (20) ;
  575.  
  576.  BEGIN
  577.   Hide_Mouse ;
  578.   Do_Screen_Aktualisieren ;
  579.   Hard_Copy ;
  580.   Draw_Menu (menu_zei) ;
  581.   Show_Mouse ;
  582.  END ;
  583.  
  584.  
  585. {---- Do_Save_Bild : Speichert Bild auf Diskette -----------------------------}
  586.  
  587. PROCEDURE Do_Save_Bild ;
  588.  
  589.  VAR  datei_name, maske : str255 ;
  590.       bild_datei        : FILE OF integer ;
  591.       index             : integer ;
  592.       count             : long_integer ;
  593.  
  594.  BEGIN
  595.   IF bild_art = mono  THEN maske := CONCAT (pfad_akt, '*.ART') ;
  596.   IF bild_art = degas THEN maske := CONCAT (pfad_akt, '*.PI3') ;
  597.   IF Get_In_File (maske, datei_name) THEN
  598.    BEGIN
  599.     Do_Screen_Aktualisieren ;
  600.     Draw_Menu (menu_zei) ;
  601.     Set_Mouse (M_Bee) ;
  602.     REWRITE (bild_datei, datei_name) ;
  603.     IF bild_art = degas THEN
  604.      BEGIN
  605.       bild_datei^ := 2 ; put (bild_datei) ;          { Auflösung }
  606.  
  607.       bild_datei^ := 1 ; put (bild_datei) ;
  608.       FOR index := 1 TO 15 DO
  609.        BEGIN
  610.         bild_datei^ := 0 ;
  611.         put (bild_datei) ;
  612.        END ;
  613.      END ;
  614.     FOR index := 0 TO 15999 DO
  615.      BEGIN
  616.       bild_datei^ := bild[index] ;
  617.       put (bild_datei) ;
  618.      END ;
  619.     Set_Mouse (M_Arrow) ;
  620.    END ;
  621.  END ;
  622.  
  623.  
  624. {---- Do_Erase_Bild : Löscht File von der Diskette ---------------------------}
  625.  
  626. PROCEDURE Do_Erase_Bild ;
  627.  
  628.  VAR  maske, datei_name, alarm : str255 ;
  629.       bild_datei               : FILE OF integer ;
  630.  
  631.  BEGIN
  632.   maske := CONCAT (pfad_akt, '*.*') ;
  633.   IF Get_In_File (maske, datei_name) THEN
  634.    BEGIN
  635.     Do_Screen_Aktualisieren ;
  636.     Draw_Menu (menu_zei) ;
  637.     alarm := CONCAT ('[2][ Die Bilddatei | ', datei_name,
  638.              ' | wirklich löschen ? ][ Ja | Nein ]') ;
  639.     button := Do_Alert (alarm, 2) ;
  640.     IF button = 1 THEN
  641.      BEGIN
  642.       Set_Mouse (M_Bee) ;
  643.       IO_Check (false) ;
  644.       RESET (bild_datei, datei_name) ;
  645.       IO_Check (true) ;
  646.       IF IO_Result = 0 THEN
  647.        ERASE (bild_datei) ;
  648.       Set_Mouse (M_Arrow) ;
  649.      END ;
  650.    END ;
  651.  END ;
  652.  
  653.  
  654. {---- Do_Show_Koordinaten : Zeigt Koordinaten  -------------------------------}
  655.  
  656. PROCEDURE Do_Show_Koordinaten ;
  657.  
  658.  VAR  x, y, butt, key         : integer ;
  659.       re_x, re_y              : real ;
  660.  
  661.  BEGIN
  662.   Erase_Menu (menu_zei) ;
  663.   Objc_Draw (ausgabe_zei) ;
  664.   IF (draw.dx <> 0) AND (draw.dy <> 0) THEN
  665.    BEGIN
  666.     REPEAT
  667.      Mouse_State (x, y, butt, key) ;
  668.      IF draw.x_log THEN
  669.       re_x := EXP (((x-20-draw.min_pot_x-draw.null_x) / draw.dx) * LN(10))
  670.      ELSE          re_x := ((x-20) - draw.null_x) / draw.dx ;
  671.      IF draw.y_log THEN
  672.       re_y := EXP (((399-y+draw.min_pot_x-draw.null_y) / draw.dy) * LN(10))
  673.      ELSE          re_y := ((399-y) - draw.null_y) / draw.dy ;
  674.      write (CHR(27), 'Y', CHR(32+4), CHR(32+54), var_x, '   : ', re_x:13:9) ;
  675.      write (CHR(27), 'Y', CHR(32+5), CHR(32+54), 'f(',var_x,'): ', re_y:13:9) ;
  676.     UNTIL butt = 1 ;
  677.    END
  678.   ELSE
  679.    button := Do_Alert
  680.    ('[3][Nicht so hudelig, erst | mal was zeichnen !][ Grrrr ]', 1) ;
  681.   End_Dialog (ausgabe_zei) ;
  682.  END ;
  683.  
  684.  
  685. {---- Event_Loop : Überwacht das Menü und mögliches Redraw -------------------}
  686.  
  687. PROCEDURE Event_Loop ;
  688.  
  689.  BEGIN
  690.   WHILE true DO
  691.    BEGIN
  692.     event := Get_Event (E_MESSAGE, 0, 0, 0, 0, false, 0, 0, 0, 0,
  693.                         false, 0, 0, 0, 0, msg, dummy, dummy, dummy,
  694.                         dummy, dummy, dummy) ;
  695.  
  696.     IF msg[0] = MN_Selected THEN
  697.      BEGIN
  698.       CASE msg[4] OF
  699.        minfo       : Do_Show_Info ;
  700.        mende       : Do_Abbruch ;
  701.        mhelp       : Do_Show_Help ;
  702.        mfktein     : Do_Eingabe_Funktion ;
  703.        meinkon     : Do_Eingabe_Konstanten ;
  704.        meingre     : Do_Eingabe_Grenzen (true) ;
  705.        mlauf       : Do_Set_Pfad ;
  706.        mdarstel    : Do_Parameter ;
  707.        mfktzei     : Do_Funktion_Zeichnen (false) ;
  708.        mdruzei     : Do_Drucken ;
  709.        mdruein     : Do_Set_Drucker ;
  710.        msavepic    : Do_Save_Bild ;
  711.        merapic     : Do_Erase_Bild ;
  712.        mscann      : Do_Show_Koordinaten ;
  713.        mwurm       : Do_Show_Wurminfo ;
  714.        mfdegas     : BEGIN
  715.                       Menu_Check (menu_zei, mfdegas, true) ;
  716.                       Menu_Check (menu_zei, mfmono, false) ;
  717.                       bild_art := degas ;
  718.                      END ;
  719.        mfmono      : BEGIN
  720.                       Menu_Check (menu_zei, mfmono, true) ;
  721.                       Menu_Check (menu_zei, mfdegas, false) ;
  722.                       bild_art := mono ;
  723.                      END ;
  724.        mfktneu     : BEGIN
  725.                       neu_fkt := NOT neu_fkt ;
  726.                       Menu_Check (menu_zei, mfktneu, neu_fkt) ;
  727.                       IF neu_fkt THEN Do_Funktion_Zeichnen (true) ;
  728.                      END ;
  729.       END ;
  730.       Menu_Normal (menu_zei, msg[3]) ;
  731.      END ;
  732.  
  733.     IF msg[0] = WM_Redraw THEN
  734.      BEGIN
  735.       Do_Screen_Aktualisieren ;
  736.       Draw_Menu (menu_zei) ;
  737.      END ;
  738.  
  739.    END ;
  740.  END ;
  741.  
  742.  
  743. {--------------------  H a u p t p r o g r a m m  ----------------------------}
  744.  
  745. BEGIN
  746.  IF Init_Gem >= 0 THEN
  747.   BEGIN
  748.    IF NOT Load_Resource ('FUNKTION.RSC') THEN
  749.     BEGIN
  750.      button := Do_Alert ('[3][RSC-File defekt !][ Abbruch ]',0) ;
  751.      Exit_Gem ;
  752.      Halt ;
  753.     END ;
  754.  
  755.  
  756.    Find_Menu (menu, menu_zei) ;
  757.  
  758.    window := New_Window (0, titel, 0, 0, 0, 0) ;
  759.    Open_Window (window, 0, 0, 0, 0) ;
  760.    bild_ptr := Bild_Ram ;
  761.  
  762.    Find_Dialog (infobox, info_zei) ;        Center_Dialog (info_zei) ;
  763.    Find_Dialog (lauf, lauf_zei) ;           Center_Dialog (lauf_zei) ;
  764.    Find_Dialog (fktein, fktein_zei) ;       Center_Dialog (fktein_zei) ;
  765.    Find_Dialog (werte, werte_zei) ;         Center_Dialog (werte_zei) ;
  766.    Find_Dialog (koein, koein_zei) ;         Center_Dialog (koein_zei) ;
  767.    Find_Dialog (darst, darst_zei) ;         Center_Dialog (darst_zei) ;
  768.    Find_Dialog (drucker, drucker_zei) ;     Center_Dialog (drucker_zei) ;
  769.    Find_Dialog (help, help_zei) ;           Center_Dialog (help_zei) ;
  770.    Find_Dialog (warten, warten_zei) ;       Center_Dialog (warten_zei) ;
  771.    Find_Dialog (wurm1, w1_zei) ;            Center_Dialog (w1_zei) ;
  772.    Find_Dialog (wurm2, w2_zei) ;            Center_Dialog (w2_zei) ;
  773.    Find_Dialog (ausgabe, ausgabe_zei) ;
  774.  
  775.    Do_Init ;
  776.    Do_Init_Error ;
  777.    Do_Init_Warnungen ;
  778.    Init_Mouse ;
  779.  
  780.    Event_Loop ;
  781.  
  782.   END ;
  783. END.
  784.